home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0043_Queit Noisy programs.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-26  |  10KB  |  275 lines
  1. (*
  2. From: DAVID DANIEL ANDERSON        Refer#: NONE
  3. Subj: QUIET USING BLOCKREAD
  4. *)
  5.  
  6. uses dos ;
  7. const
  8.      bufsize  = 16384;
  9.      progdata = 'QUIET- Free DOS utility: quiets noisy programs.';
  10. {!}  progdat2 =
  11. 'V1.00: August 27, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  12. {!}  usage   =
  13.      'Usage:  QUIET noisy_prog  {will OVERWRITE the file - use a backup!!!}';
  14.      outname = 'o$_$_$$!.DDA';
  15.      tmpname = 't$_$_$$!.DDA';
  16. type
  17.    buffer       = array [1..bufsize] of char;
  18. var
  19.    buf          : buffer ;
  20.    infile,
  21.    outfile      : file ;
  22.    bytesread,
  23.    byteswritten : word ;
  24.  
  25.    nextchar     : char ;
  26.  
  27.    checknext,
  28.    extra_char,
  29.    lastbyte     : boolean ;
  30.  
  31.    fdt          : longint ;
  32.  
  33.    dirinfo       : searchrec ;   { contains filespec info.    }
  34.    spath         : pathstr ;     { source file path,          }
  35.    sdir          : dirstr ;      {             directory,     }
  36.    sname         : namestr ;     {             name,          }
  37.    sext          : extstr ;      {             extension.     }
  38.    sfn, dfn, tfn : string [64];  { Source/ Dest/ Temp FileName, including dir }
  39.    filesdone     : array [1..512] of string [64];   { table of each dir+name  }
  40.    done          : boolean ;  { done is used so a file is not processed twice }
  41.                               { used with the array "filesdone" because a bug }
  42.                               { (in DOS I think) causes files to be selected  }
  43.                               { based on FAT placement, rather than name when }
  44.                               { wildcards are implemented.  The BUG allows    }
  45.                               { files to be done repeatedly, every time they  }
  46.                               { are encountered.                              }
  47.  
  48.    i, nmdone      : word ;    { i is a counter,  }
  49.                               { nmdone is number of files wrapped }
  50.  
  51.  
  52. procedure showhelp ( errornum : byte );
  53. var
  54.     message : string [80];
  55. begin
  56.     writeln ( progdata );
  57.     writeln ( progdat2 );
  58.     writeln ;
  59.     writeln ( usage );
  60.     writeln ;
  61.                        {!}  { all of the case messages got reformatted }
  62.     case errornum of
  63.       1 : message :=
  64. 'you must specify -exactly- one filespec (wildcards are OK).';
  65.       2 : message :=
  66. 'could not open the "noisy" file: ' + sfn + ' (may be read-only).';
  67.       3 : message :=
  68. 'could not open the temp file (does ' + outname + ' already exist?).';
  69.       4 : message :=
  70. 'the blockread procedure failed ( error reading "noisy" file: ' + sfn + '.';
  71.       5 : message :=
  72. 'rename procedure failed, "quiet" file is ' + outname + '.';
  73.       6 : message :=
  74. 'original file was read only, is renamed to ' + tmpname + '.';
  75.       7 : message :=
  76. 'you cannot just specify a path, add "*.*" or "\*.*" for all files.';
  77.       8 : message :=
  78. 'could not find any matching files.';
  79.     end;
  80.     writeln ( 'ERROR: (#',errornum,') - ', message );
  81.     halt ( errornum );
  82. end;
  83. procedure openfiles(var ofl, nfl : file; name1, name2 : string);
  84. begin
  85. {$i-}
  86.      assign ( ofl, name1 );
  87.      reset ( ofl,1 );
  88.      if ioresult <> 0 then
  89.         showhelp (2);                          { unable to open ??? }
  90.  
  91.      assign ( nfl, name2 );
  92.      reset ( nfl );
  93.      if ( ioresult <> 0 ) then begin       {  if file does -NOT- exist  }
  94.         rewrite ( nfl,1 );                 { yet, it is save to proceed }
  95.         if ioresult <> 0 then                  { unable to open ??? }
  96.            showhelp (3) ;
  97.      end
  98.      else
  99.         showhelp (3) ;
  100. {$i+}
  101. end;
  102.  
  103. {!} procedure quietbuf
  104.      ( var bufr : buffer; var chknext : boolean ; var noises : word );
  105. const
  106.      noisea  = 'µ';
  107.      noiseb  = 'a';
  108.      NOPChar = 'É';
  109. var
  110.      bf_indx  : word ;
  111. begin
  112.      for bf_indx := 1 to ( sizeof ( bufr ) - 1 ) do
  113.          if ( ( bufr [ bf_indx ]    = noisea ) and
  114.               ( bufr [ bf_indx +1 ] = noiseb ) ) then begin
  115.  
  116.                 noises := noises + 1 ;
  117.                 bufr [ bf_indx ]    := NOPChar;
  118.                 bufr [ bf_indx +1 ] := NOPChar;
  119.          end;
  120.      chknext := ( bufr [ sizeof ( bufr ) ] = noisea );
  121. end;
  122.  
  123. procedure quietfile ( var infile, outfile : file );
  124. var
  125.      noises : word ;
  126. begin
  127.      noises := 0;
  128.      repeat
  129. {$i-}     blockread  ( infile, buf, bufsize, bytesread );   {$i+}
  130.           if ioresult <> 0 then
  131.              showhelp (4) ;
  132.           quietbuf ( buf, checknext, noises );
  133.  
  134.           if ( checknext and ( not eof ( infile ))) then begin
  135.              blockread ( infile, nextchar, 1 );
  136.              extra_char := true ;
  137.              if nextchar = 'a' then begin
  138.                 noises := noises + 1 ;
  139.                 buf [ sizeof ( buf ) ] := 'É';
  140.                 nextchar := 'É';
  141.              end;
  142.           end
  143.           else extra_char := false ;
  144.  
  145.           blockwrite ( outfile, buf, bytesread, byteswritten );
  146.           if extra_char then
  147.              blockwrite ( outfile, nextchar, 1 );
  148.           lastbyte := (( bytesread = 0 ) or ( bytesread <> byteswritten ));
  149.      until lastbyte ;
  150.      writeln ( noises, ' noises found.' );
  151. end;
  152.  
  153. begin  { MAIN }
  154.      if paramcount <> 1 then showhelp (1);
  155.      nmdone := 1;                       { initialize number done to one since }
  156.                                     { count is incremented after process ends }
  157.  
  158.      for i := 1 to 512 do               { initialize array                    }
  159.          filesdone[i] := '';            { (I'm not sure if this is needed)    }
  160.  
  161.      spath := paramstr (1);             { source path is first parameter      }
  162.  
  163.   fsplit ( fexpand (spath),sdir,sname,sext); { break up path into components  }
  164.      if (sname = '') then               { - but quit if only a path and no    }
  165.          showhelp(7);                   { name is given                       }
  166.  
  167.      findfirst (spath, archive, dirinfo); { find the first match of filespec  }
  168.      if doserror <> 0 then
  169.         showhelp(8);
  170.  
  171.      while doserror = 0 do              { process all specified files         }
  172.      begin
  173.           sfn := sdir+dirinfo.name;    { should have dir info so we are not   }
  174.                                        { confused with current directory (?)  }
  175.                                       { IS needed for dest and temp filenames }
  176.  
  177.           done := false;               { initialize for each "new" file found }
  178.           for i := 1 to 512 do
  179.               if sfn = filesdone[i] then { check entire array to see if we    }
  180.               done := true;              { have done this file already        }
  181.  
  182.           if not done then begin        { if not, then                        }
  183.               filesdone[nmdone] := sfn; { say we have now                     }
  184.               dfn := sdir+outname;      { give both dest and                  }
  185.               tfn := sdir+tmpname;      {       and temp files unique names   }
  186.  
  187.               openfiles ( infile, outfile, sfn, dfn );
  188.               write ( 'Quieting ', sfn, ', ' );
  189.               quietfile ( infile, outfile );
  190.  
  191.               getftime ( infile, fdt );
  192.               setftime ( outfile, fdt );
  193.  
  194.               close (infile);           { close in                            }
  195.               close (outfile);          {   and out files                     }
  196.  
  197. {i-}
  198.               rename ( infile, tfn );   { rename in to temp and then   }
  199.               if ioresult <> 0 then
  200.                  showhelp (5);
  201.               rename ( outfile, sfn );  { out to in, thereby SWITCHING  }
  202.               erase ( infile );         { in with out so we can erase in (!)  }
  203.               if ioresult <> 0 then
  204.                  showhelp (6);
  205. {$i+}
  206.               nmdone := nmdone + 1;     { increment number processed          }
  207.           end;  { if not done }
  208.           findnext(dirinfo);            { go to next (until no more)          }
  209.      end;  { while }
  210. end.
  211.  
  212.  
  213.                                      QUIET
  214.                     Free DOS utility: quiets noisy programs
  215.                          Version 1.00 - August 27, 1993
  216.                                     (c) 1993
  217.                                        by
  218.                              David Daniel Anderson
  219.                                    Reign Ware
  220.  
  221.  
  222.  
  223.  
  224.  
  225. QUIET quiets noisy programs, by replacing certain noisemaking program
  226. codes.
  227.  
  228. WARNING!!! QUIET OVERWRITES THE INPUT FILE, SO MAKE SURE THAT YOU
  229. EITHER WORK ON A -COPY- OF YOUR FILE(S) OR YOU KNOW WHAT YOU ARE
  230. DOING BEFORE YOU START.
  231.  
  232. Usage:  QUIET noisy_prog
  233.  
  234. Examples:
  235.  
  236.    QUIET hangman.com
  237.    QUIET *.exe
  238.    QUIET pac*.*
  239.    QUIET d:\games\fire.com
  240.  
  241. QUIET needs one and only one parameter on the command line: the file
  242. to be silenced.  By using wildcards (* and ?), multiple files can be
  243. processed in one pass.  (See the DOS manual for wildcard info.)
  244.  
  245. QUIET will maintain the original date and time of the file(s).
  246.  
  247.  
  248.                              How it works:
  249.  
  250. QUIET simply replaces the two-byte sequence: µa  with: ÉÉ
  251. In hex, that is:   E6 61   and:   90  90.
  252. In decimal it is: 230 97   and:  144 144.
  253.  
  254. The E6 61 code is simply an instruction to activate the speaker, and
  255. the 90 90 code is simply an instruction to do nothing.
  256.  
  257.  
  258.               Possible complications/ reasons for failure:
  259.  
  260. 1) Some programs check themselves, and will not work at all if they
  261. have been changed.
  262.  
  263. 2) Many programs make noise by other methods, and will not be silenced.
  264.  
  265. 3) If the file was read-only, it cannot be processed.
  266.  
  267. 4) Some virus detectors will complain if you try this on a file which
  268. you have told the watch dog program to monitor.
  269.  
  270. Note: other errors are mentioned by the program when it encounters them.
  271.  
  272. ---
  273.  ■ SLMR 2.1a ■
  274.  ■ RNET 2.00m: ILink: Channel 1(R) ■ Cambridge, MA ■ 617-354-7077
  275.